home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 196_01 / bit78061.for < prev    next >
Text File  |  1985-11-13  |  4KB  |  147 lines
  1. C [BIT7861.FOR of JUGPDS Vol.19]
  2. Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  3. C                                                                             c
  4. C         four color probrem test                                             c
  5. C                                                                             c
  6. C         nano pico kyositu bit 78-06 (vol10-07) p85-87                       c
  7. C                                                                             c
  8. C         data entered by toshiya oota & studio gala 85-06-13                 c
  9. C                                                                             c
  10. C                                                                             c
  11. Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  12. C
  13.       dimension jv(3,30),js(30),jn(30),kf(7,20),kn(20),kc(20)
  14. C     js       .......... sign
  15. C     jn       .......... colored faces
  16. C     kn       .......... no of sides
  17. C     nverti   .......... no of vertices
  18. C     nface    .......... no of faces
  19. C
  20. C     read no of vertices & faces
  21.       call open(5,'FORT05  DAT',0)
  22.  1000 read(5,100) nverti,nface
  23.   100 format(2i5)
  24.       if (nverti.le.0) goto 99
  25.       write(1,600) nverti,nface
  26.   600 format(//1h ,'no . vertices=',i5,'  no. faces=',i5/)
  27.       do 1 i=1,nface
  28.           kn(i) = 0
  29.     1 kc(i) = -1
  30.       do 2 i=1,nverti
  31.           js(i) = 0
  32.           jn(i) = 0
  33. C     initial input of data
  34.           read(5,110) (jv(j,i),j=1,3)
  35.   110     format(3i5)
  36.           write(1,210) i,(jv(j,i),j=1,3)
  37.   210     format(1h ,'vertice no=',i5,'  face no =',3i5)
  38. C     preparation,setting vertices for each face
  39.           do 5 j=1,3
  40.                ind = jv(j,i)
  41.                k = kn(ind) + 1
  42.                kf(k,ind) = i
  43.                kn(ind) = k
  44.     5     continue
  45.     2 continue
  46.       write(1,290)
  47.   290 format(/1h )
  48. C output of vertices for each face
  49.       do 8 i=1,nface
  50.           k = kn(i)
  51.           write(1,220) i,k,(kf(j,i),j=1,k)
  52.   220     format(1h ,'face no=',i3,'   no of vertices=',i3,
  53.      +           '   vertice no =',7i5)
  54.     8 continue
  55. C     test of sign on vertices
  56.    10 do 20 i=1,nface
  57.           ind = kn(i)
  58.           ism = ind
  59.           do 12 j=1,ind
  60.                k = kf(j,i)
  61.    12     ism = ism + js(k)
  62.           if ((ism/3)*3.ne.ism) goto 50
  63.    20 continue
  64. C     getting suitable sign
  65.       write(1,290)
  66.       write(1,230) (i,i=1,nverti)
  67.       write(1,230) (js(i),i=1,nverti)
  68.   230 format(1h ,30i3)
  69. C     coloring procedure
  70.       ind = jv(1,1)
  71.       kc(ind) = 0
  72.       ind = jv(2,1)
  73.       kc(ind) = 1
  74.       ind = jv(3,1)
  75.       kc(ind) = 2+js(1)
  76.       do 30 i=1,nverti
  77.           do 31 k=1,3
  78.                ind = jv(k,i)
  79.                if (kc(ind).ge.0) jn(i) = jn(i) + 1
  80.    31     continue
  81.    30 continue
  82. C     search for uncolored face
  83.    33 do 35 i=2,nverti
  84.           if (jn(i).eq.2) goto 40
  85.    35 continue
  86. C     finish,output the coloring
  87.       write(1,290)
  88.       write(1,250) (i,i=1,nface)
  89.       write(1,250) (kc(i),i=1,nface)
  90.   250 format(1h ,20i3)
  91.       write(6,290)
  92.                           goto 1000
  93. C     looking for the uncolored face
  94.    40 do 41 k=1,3
  95.           ind = jv(k,i)
  96.           if (kc(ind).lt.0) goto 42
  97.    41 continue
  98. C     implementation of tait algorithm
  99.    42 j = jrs(k)
  100.       m1 = jv(j,i)
  101.       m1 = kc(m1)
  102.       j = jrs(j)
  103.       m2 = jv(j,i)
  104.       m2 = kc(m2)
  105.       ism = nsw(m1,m2)
  106.       j = jrs(ism)
  107.       if (js(i).eq.1) j = jrs(j)
  108.       kc(ind) = nsw(m1,j)
  109.       k = kn(ind)
  110.       do 45 i=1,k
  111.           j = kf(i,ind)
  112.           jn(j) = jn(j) + 1
  113.    45 continue
  114.                           goto 33
  115. C     add 1 to the binary number js(i)
  116.    50 ism = nverti-1
  117.       do 55 k=1,ism
  118.           if (js(k).eq.0) goto 57
  119.    55 continue
  120.       write(1,270)
  121.   270 format(1h ,'IMPOSSIBLE!!!')
  122.                           goto 1000
  123. C     1 & 0 are interchangable. hence js(nface) may be fixed to 0.
  124.    57 js(k) = 1
  125.       if (k.eq.1) goto 10
  126.       k = k - 1
  127.       do 58 i=1,k
  128.    58 js(i) = 0
  129.                           goto 10
  130.    99 write(1,290)
  131.       stop
  132.       end
  133. C
  134.       function nsw(m1,m2)
  135. C     binary addition for two bits
  136.       nsw=iabs(m1-m2)
  137.       if(m1+m2.eq.3) nsw=3
  138.       return
  139.       end
  140. C
  141.       function jrs(m1)
  142. C     add 1 in mod 3
  143.       jrs=m1+1
  144.       if(m1.eq.3) jrs=1
  145.       return
  146.       end
  147.